home *** CD-ROM | disk | FTP | other *** search
/ Night Owl 6 / Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso / 037a / plife.zip / PLIFE.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-02  |  21KB  |  690 lines
  1. {**************************************************}
  2. {                    Life 1.0                      }
  3. {                    Written in                    }
  4. {             Turbo Pascal for Windows             }
  5. {                Copyright (c) 1991                }
  6. {                  Zack Urlocker                   }
  7. {                    05/02/91                      }
  8. {**************************************************}
  9.  
  10. program PLife;
  11.  
  12. { This is a simple implementation of the Game of Life written
  13.   in Turbo Pascal for Windows using the ObjectWindows application
  14.   framework.  The program is divided into three main object types:
  15.  
  16.   TLifeApplication  --creates and shows the main window
  17.   TLifeWindow       --responds to Windows messages, menu commands,
  18.                       keyboard and mouse events
  19.   TLifeCells        --mutates and draws the cells in the window
  20. }
  21.  
  22. {$R PLife.res}        { Link in resources }
  23.  
  24. {$IFDEF Final}        { Remove debug code for final version}
  25. {$D-,I-,L-,R-,S-}
  26. {$ELSE}
  27. {$D+,I+,L+,R+,S+}
  28. {$ENDIF}
  29.  
  30. uses WObjects, WinTypes, WinProcs, Strings, StdDlgs;
  31.  
  32. const
  33.   cm_Clear   = 201;        { command menu constant IDs }
  34.   cm_Go      = 202;
  35.   cm_Trace   = 203;
  36.   cm_Stop    = 204;
  37.   cm_Exit    = 209;
  38.   cm_About   = 210;
  39.   cm_Timer   = 301;
  40.   cm_Grid    = 302;
  41.   cm_Zoom    = 303;
  42.   cm_Random  = 401;
  43.   cm_Bloom   = 402;
  44.   cm_Walker  = 403;
  45.   cm_Help    = 501;
  46.   cm_CmdMode = 601;      { For Lotus style slash (/) key commands }
  47.  
  48.   XMax       = 100;      { Maximum matrix size }
  49.   YMax       = 100;      { Only visible portion is used }
  50.   MaxGrid    = 50;       { Maximum grid size for Zoom }
  51.   MinGrid    = 10;       { Minimum grid size for Zoom }
  52.  
  53.   Dead =   False;        { cell values }
  54.   Born =    True;
  55.  
  56.   Black = $000000;       { Windows color constants }
  57.   White = $FFFFFF;
  58.   Blue  = $FF0000;
  59.  
  60.  
  61. type
  62.  
  63.   { The application defines startup behavior for the window. }
  64.   TLifeApplication = object(TApplication)
  65.     procedure InitInstance; virtual;
  66.     procedure InitMainWindow; virtual;
  67.   end;
  68.  
  69.   Matrix = array [0..XMax, 0..YMax] of Boolean;
  70.  
  71.   { The cells are responsible for mutating and drawing in a window.
  72.     The cells will be notified whenever the size of the grid or
  73.     number of rows and columns in the window changes.    }
  74.   TLifeCells = object(TObject)
  75.     cells : matrix;                { actual cells        }
  76.     scratchCells : matrix;         { scratch work area   }
  77.     rows : integer;                { visible rows        }
  78.     cols : integer;                { visible columns     }
  79.     gridSize : integer;            { for drawing a cell  }
  80.     constructor init;              { initialize cells    }
  81.     procedure mutate(DC:HDC);      { mutate all cells    }
  82.     procedure draw(DC:HDC);        { draw all cells      }
  83.     procedure setCell(i,j:Integer; alive: Boolean);
  84.     function aliveCell(i,j:Integer): Boolean;
  85.     procedure walker(i,j:Integer);
  86.     procedure bloom(i,j:Integer);
  87.     procedure mutateCell(DC:HDC; i,j: integer);
  88.     procedure drawCell(DC:HDC; i, j:Integer; alive: Boolean);
  89.   end;
  90.  
  91.   { The window handles keyboard, mouse messages and controls cells. }
  92.   PLifeWindow = ^TLifeWindow;
  93.   TLifeWindow = object(TWindow)
  94.     cells : TLifeCells;            { cells being mutated }
  95.     speed : Integer;               { timer speed         }
  96.     running : Boolean;             { is timer running?   }
  97.     rows : Integer;                { visible rows        }
  98.     cols : Integer;                { visible columns     }
  99.     grid : Boolean;                { is grid turned on?  }
  100.     gridSize : Integer;            { for drawing a cell  }
  101.     mouseDown : Boolean;           { is mouse down?      }
  102.     xDown : Integer;               { x location in grid  }
  103.     yDown : Integer;               { y location in grid  }
  104.     mutateDC : HDC;                { draw each mutation  }
  105.     mouseMoveDC : HDC;             { draw mouse moves    }
  106.     constructor Init(AParent: PWindowsObject; ATitle: PChar);
  107.     procedure GetWindowClass(var WndClass: TWndClass); virtual;
  108.  
  109.     { menu response methods }
  110.     procedure Clear(var Msg: TMessage); virtual cm_First + cm_Clear;
  111.     procedure Randomize(var Msg: TMessage); virtual cm_First + cm_Random;
  112.     procedure Bloom(var Msg: TMessage); virtual cm_First + cm_Bloom;
  113.     procedure Walker(var Msg: TMessage); virtual cm_First + cm_Walker;
  114.     procedure Go(var Msg: TMessage); virtual cm_First + cm_Go;
  115.     procedure Trace(var Msg: TMessage); virtual cm_First + cm_Trace;
  116.     procedure Stop(var Msg: TMessage); virtual cm_First + cm_Stop;
  117.     procedure Exit(var Msg: TMessage); virtual cm_First + cm_Exit;
  118.     procedure About(var Msg: TMessage); virtual cm_First + cm_About;
  119.     procedure Timer(var Msg: TMessage); virtual cm_First + cm_Timer;
  120.     procedure GridToggle(var Msg: TMessage); virtual cm_First + cm_Grid;
  121.     procedure Zoom(var Msg: TMessage); virtual cm_First + cm_Zoom;
  122.     procedure Help(var Msg: TMessage); virtual cm_First + cm_Help;
  123.     procedure CmdMode(var Msg: TMessage); virtual cm_First + cm_CmdMode;
  124.  
  125.     { windows message response methods }
  126.     procedure Paint(DC: HDC; var PaintInfo: TPaintStruct); virtual;
  127.     procedure DrawGrid(DC: HDC);
  128.     procedure wmSetFocus(var Msg: TMessage); virtual wm_SetFocus;
  129.     procedure wmKillFocus(var Msg: TMessage); virtual wm_KillFocus;
  130.     procedure wmKeyDown(var Msg: TMessage); virtual wm_KeyDown;
  131.     procedure wmLButtonDown(var Msg: TMessage); virtual wm_LButtonDown;
  132.     procedure wmLButtonUp(var Msg: TMessage); virtual wm_LButtonUp;
  133.     procedure wmLButtonDblClk(var Msg: TMessage); virtual wm_LButtonDblClk;
  134.     procedure wmMouseMove(var Msg: TMessage); virtual wm_MouseMove;
  135.     procedure wmRButtonDown(var Msg: TMessage); virtual wm_RButtonDown;
  136.     procedure wmTimer(var Msg: TMessage); virtual wm_Timer + wm_First;
  137.     procedure wmSize(var Msg: TMessage); virtual wm_Size;
  138.     procedure wmGetMinMaxInfo(var Msg: TMessage); virtual wm_GetMinMaxInfo;
  139.     procedure wmDestroy(var Msg: TMessage); virtual wm_Destroy;
  140.   end;
  141.  
  142.  
  143. {--------------------------------------------------}
  144. { TLifeApplication's method implementations:       }
  145. {--------------------------------------------------}
  146.  
  147. { Load the accelerator table for hotkeys }
  148. procedure TLifeApplication.InitInstance;
  149. begin
  150.   Tapplication.InitInstance;
  151.   HAccTable := LoadAccelerators(HInstance, 'LifeKeys');
  152. end;
  153.  
  154. { Start the main window }
  155. procedure TLifeApplication.InitMainWindow;
  156. begin
  157.   MainWindow := New(PLifeWindow, Init(nil, 'PLife'));
  158. end;
  159.  
  160.  
  161. {--------------------------------------------------}
  162. { TLifeCell's method implementations:              }
  163. {--------------------------------------------------}
  164.  
  165. { Clear out the cell matrices }
  166. constructor TLifeCells.Init;
  167. begin
  168.   fillchar(cells, sizeOf(cells), 0);
  169.   fillchar(scratchCells, sizeOf(scratchCells), 0);
  170. end;
  171.  
  172. { Is the cell alive? }
  173. function TLifeCells.aliveCell(i,j:Integer) : Boolean;
  174. begin
  175.   aliveCell := cells[i,j];
  176. end;
  177.  
  178. { Set the cell to born or dead state }
  179. procedure TLifeCells.setCell(i,j:Integer; alive:Boolean);
  180. begin
  181.   cells[i, j] := alive;
  182. end;
  183.  
  184. { Create an interesting pattern that "walks" across the screen }
  185. procedure TLifeCells.walker(i, j:Integer);
  186. begin
  187.   cells[i,j+2] := Born;
  188.   cells[i+1,j+2] := Born;
  189.   cells[i+2,j+2] := Born;
  190.   cells[i+2,j+1] := Born;
  191.   cells[i+1,j] := Born;
  192. end;
  193.  
  194. { Create an interesting pattern that "blooms" across the screen }
  195. procedure TLifeCells.bloom(i, j:Integer);
  196. begin
  197.   cells[i+1,j] := Born;
  198.   cells[i,j+1] := Born;
  199.   cells[i,j+2] := Born;
  200.   cells[i,j+3] := Born;
  201.   cells[i+1,j+3] := Born;
  202.   cells[i+2,j+3] := Born;
  203.   cells[i+2,j+2] := Born;
  204.   cells[i+2,j+1] := Born;
  205. end;
  206.  
  207. { Draw a single cell as a borderless rectangle }
  208. procedure TLifeCells.drawCell(DC: HDC; i, j: Integer; alive: Boolean);
  209. var xScreen, yScreen : Integer;
  210.   color : TColorRef;
  211. begin
  212.   xScreen := i * gridSize;
  213.   yScreen := j * gridSize;
  214.   if alive then
  215.     color := Blue
  216.   else
  217.     color := White;
  218.   SelectObject(DC, CreateSolidBrush(color));
  219.   rectangle(DC, xScreen+1, yScreen+1, xScreen+gridSize-1, yScreen+gridSize-1);
  220.   DeleteObject(SelectObject(DC, GetStockObject(Black_Brush)));
  221. end;
  222.  
  223. { Redraw active cells on screen }
  224. procedure TLifeCells.draw(DC:HDC);
  225. var i, j, xScreen, yScreen : Integer;
  226. begin
  227.   for i:= 1 to cols do
  228.     for j := 1 to rows do
  229.       if cells[i,j] then
  230.         drawCell(DC, i, j, born);
  231. end;
  232.  
  233. { Determine how the cell should mutate by the number of neighbors
  234.   it has.  Too few or too many means it should die.  }
  235. procedure TLifeCells.mutateCell(DC:HDC; i, j : integer);
  236. var neighbors : Integer;
  237.     temp : Integer;
  238. begin
  239.   neighbors := 0;
  240.   if cells[i-1, j]  then inc(neighbors);
  241.   if cells[i+1, j]  then inc(neighbors);
  242.   if cells[i, j-1]  then inc(neighbors);
  243.   if cells[i, j+1]  then inc(neighbors);
  244.   if cells[i-1, j-1] then inc(neighbors);
  245.   if cells[i+1, j+1] then inc(neighbors);
  246.   if cells[i-1, j+1] then inc(neighbors);
  247.   if cells[i+1, j-1] then inc(neighbors);
  248.  
  249.   if not cells[i, j] then      { it's a dead cell }
  250.     if neighbors = 3 then      { bring it to life }
  251.     begin
  252.       scratchCells[i, j] :=  Born;
  253.       drawCell(DC, i, j, Born);
  254.     end
  255.     else
  256.       scratchCells[i, j] := cells[i, j]
  257.  
  258.   else                         { it's a live cell }
  259.  
  260.     if (neighbors < 2) or (neighbors > 3) then   { kill it }
  261.     begin
  262.       scratchCells[i,j] := Dead;
  263.       drawCell(DC, i, j, Dead);
  264.     end
  265.     else
  266.       scratchCells[i,j] := cells[i,j];
  267. end;
  268.  
  269. { Mutate all of the visible cells }
  270. procedure TLifeCells.mutate(DC:HDC);
  271. var i, j : Integer;
  272. begin
  273.   for i:= 1 to cols do
  274.     for j := 1 to rows do
  275.       mutateCell(DC, i, j);
  276.   { update the real matrix }
  277.   cells := scratchCells;
  278. end;
  279.  
  280.  
  281. {--------------------------------------------------}
  282. { TLifeWindow's method implementations:            }
  283. {--------------------------------------------------}
  284.  
  285. { Initialize all fields to starting values, set attributes }
  286. constructor TLifeWindow.Init(AParent: PWindowsObject; ATitle: PChar);
  287. begin
  288.   TWindow.Init(AParent, ATitle);
  289.   cells.init;
  290.   running := False;
  291.   speed := 500;
  292.   grid := True;
  293.   gridSize := 20;
  294.   cells.gridSize := 20;
  295.   mouseDown := False;
  296.   with attr do
  297.   begin
  298.     w:=400;          { Force window size }
  299.     h:=300;
  300.   end;
  301. end;
  302.  
  303. { Override default cursor, icon, menu and style }
  304. procedure TLifeWindow.GetWindowClass(var WndClass: TWndClass);
  305. begin
  306.   TWindow.GetWindowClass(WndClass);
  307.   WndClass.Style := CS_DBLCLKS;    { Respond to double click }
  308.   WndClass.hCursor := LoadCursor(hInstance, 'LifeCur');
  309.   WndClass.hIcon := LoadIcon(hInstance, 'LifeIco');
  310.   WndClass.lpszMenuName := 'LifeMenu';
  311. end;
  312.  
  313. { Create a display context for drawing and mutate the cells.
  314.   Use a white pen for the border, then set it back when done. }
  315. procedure TLifeWindow.wmTimer(var Msg: TMessage);
  316. begin
  317.   mutateDC:=getDC(HWindow);
  318.   selectObject(mutateDC, GetStockObject(White_Pen));
  319.   cells.mutate(mutateDC);
  320.   selectObject(mutateDC, GetStockObject(Black_Pen));
  321.   releaseDC(HWindow, mutateDC);
  322. end;
  323.  
  324. { Single step by stopping the timer and then mutate once }
  325. procedure TLifeWindow.Trace(var Msg: TMessage);
  326. var DC : HDC;
  327. begin
  328.   stop(Msg);
  329.   wmTimer(Msg);
  330. end;
  331.  
  332. { Randomly create a starting pattern }
  333. procedure TLifeWindow.Randomize(var Msg: TMessage);
  334. var i, j : integer;
  335. begin
  336.   clear(Msg);
  337.   for i:= 1 to cols do
  338.     for j := 1 to rows do
  339.       if random(100) < 25 then
  340.     cells.setCell(i, j, born);
  341.   invalidateRect(HWindow, nil, True);
  342. end;
  343.  
  344. { Create a non-random starting pattern }
  345. procedure TLifeWindow.Bloom(var Msg: TMessage);
  346. var i, j : Integer;
  347. begin
  348.   clear(Msg);
  349.   for i := 0 to cols div 7 do
  350.     for j := 0 to rows div 7 do
  351.     if not odd(i+j) then
  352.       cells.bloom(4+I*7, 2+j*7);
  353.   invalidateRect(HWindow, nil, True);
  354. end;
  355.  
  356. { Create a non-random starting pattern }
  357. procedure TLifeWindow.Walker(var Msg: TMessage);
  358. var i, j : Integer;
  359. begin
  360.   clear(Msg);
  361.   for i := 0 to cols div 7 do
  362.     for j := 0 to rows div 7 do
  363.     if not odd(i+j) then
  364.       cells.Walker(2+I*7, 2+j*7);
  365.   invalidateRect(HWindow, nil, True);
  366. end;
  367.  
  368. { Start the timer and update the menus }
  369. procedure TLifeWindow.Go(var Msg: TMessage);
  370. begin
  371.   if SetTimer(HWindow, 1, speed, nil) <> 0 then
  372.   begin
  373.     running := True;
  374.     modifyMenu(GetMenu(HWindow), cm_Go, mf_ByCommand or mf_Grayed,
  375.            cm_Go, '&Go' + #9 + '^G');
  376.     modifyMenu(GetMenu(HWindow), cm_Stop, mf_ByCommand or mf_Enabled,
  377.            cm_Stop,  '&Stop'+ #9 + '^S');
  378.   end
  379.   else
  380.   begin
  381.     running := False;
  382.     messageBeep(0);
  383.     messageBox(HWindow, 'No timers left to run Life;' + #13 +
  384.                         'Close some windows and retry!' ,
  385.                         'Error', mb_Ok + mb_IconStop);
  386.   end;
  387. end;
  388.  
  389. { Stop the timers and update the menus }
  390. procedure TLifeWindow.Stop(var Msg: TMessage);
  391. begin
  392.   modifyMenu(GetMenu(HWindow), cm_Go, mf_ByCommand or mf_Enabled,
  393.          cm_Go, '&Go'+#9 + '^G');
  394.   modifyMenu(GetMenu(HWindow), cm_Stop, mf_ByCommand or mf_Grayed,
  395.              cm_Stop,  '&Stop'+ #9 + '^S');
  396.   running := False;
  397.   killTimer(HWindow, 1);
  398. end;
  399.  
  400. { Exit the program }
  401. procedure TLifeWindow.Exit(var Msg: TMessage);
  402. begin
  403.   postQuitMessage(0);
  404. end;
  405.  
  406. { Display About box }
  407. procedure TLifeWindow.About(var Msg: TMessage);
  408. var  Dlg: TDialog;
  409. begin
  410.   Dlg.Init(@Self, 'AboutDlg');
  411.   Dlg.Execute;
  412.   Dlg.Done;
  413. end;
  414.  
  415. { Stop current timer, prompt for new speed, restart }
  416. procedure TLifeWindow.Timer(var Msg: TMessage);
  417. var
  418.   inputText: array[0..9] of Char;
  419.   newSpeed, errorPos: Integer;
  420. begin
  421.   stop(Msg);
  422.   str(speed, inputText);
  423.   if application^.ExecDialog(New(PInputDialog,
  424.       Init(@Self, 'Timer Speed', 'Input new time (milliseconds):',
  425.       inputText, sizeOf(inputText)))) = id_Ok then
  426.   begin
  427.     val(InputText, newSpeed, errorPos);
  428.     if errorPos = 0 then
  429.       speed := newSpeed
  430.     else
  431.       messageBeep(0);
  432.   end;
  433.   go(Msg);
  434. end;
  435.  
  436. { Stop, clear the matrix, restart }
  437. procedure TLifeWindow.Clear(var Msg: TMessage);
  438. var paused : Boolean;
  439. begin
  440.   paused := running;
  441.   stop(Msg);
  442.   cells.init;
  443.   invalidateRect(HWindow, nil, True);
  444.   if paused then
  445.     go(Msg);
  446. end;
  447.  
  448. { Toggle the displaying of the grid and redraw }
  449. procedure TLifeWindow.GridToggle(var Msg: TMessage);
  450. var  style : word;
  451. begin
  452.   grid := not grid;
  453.   if grid then
  454.     style := mf_Checked
  455.   else
  456.     style := mf_Unchecked;
  457.   checkMenuItem(GetMenu(HWindow), cm_Grid, style);
  458.   drawMenuBar(HWindow);
  459.   invalidateRect(HWindow, nil, True);
  460. end;
  461.  
  462. { Zoom the display, update internal info then redraw }
  463. procedure TLifeWindow.Zoom(var Msg: TMessage);
  464. begin
  465.   gridSize := gridSize * 2;
  466.   if gridSize > MaxGrid then
  467.     gridSize := MinGrid;
  468.   cols := attr.w div gridSize;
  469.   rows := attr.h div gridSize;
  470.   { update the cells }
  471.   cells.rows := rows;
  472.   cells.cols := cols;
  473.   cells.gridSize := gridSize;
  474.   invalidateRect(HWindow, nil, True);
  475. end;
  476.  
  477. procedure TLifeWindow.Help(var Msg: TMessage);
  478. var  Dlg: TDialog;
  479. begin
  480.   Dlg.Init(@Self, 'HelpDlg');
  481.   Dlg.Execute;
  482.   Dlg.Done;
  483. end;
  484.  
  485. { Respond to Lotus style commands from slash (/) accelerator }
  486. procedure TLifeWindow.CmdMode(var Msg: TMessage);
  487. begin
  488.   sendMessage(HWindow, WM_SYSCOMMAND, $F100, 0);
  489. end;
  490.  
  491. { Draw the grid and the cells }
  492. procedure TLifeWindow.Paint(DC: HDC; var PaintInfo: TPaintStruct);
  493. var i : integer;
  494. begin
  495.   selectObject(DC, GetStockObject(Black_Pen));
  496.   if grid then DrawGrid(DC);
  497.   selectObject(DC, GetStockObject(White_Pen));
  498.   cells.draw(DC);
  499. end;
  500.  
  501. { Draw the grid background. }
  502. procedure TLifeWindow.DrawGrid(DC: HDC);
  503. var i : integer;
  504. begin
  505.   for i := 1 to rows do
  506.   begin
  507.     moveTo(DC, 0, i*gridSize);
  508.     lineTo(DC, attr.w, i*gridSize);
  509.   end;
  510.   for i := 1 to cols do
  511.   begin
  512.     moveTo(DC, i*gridSize, 0);
  513.     lineTo(DC, i*gridSize, attr.h);
  514.   end;
  515. end;
  516.  
  517. { Ensure that cursor is visible even when no mouse }
  518. procedure TLifeWindow.wmSetFocus(var Msg: TMessage);
  519. begin
  520.   ShowCursor(True);
  521. end;
  522.  
  523. { Return cursor to previous state for other windows }
  524. procedure TLifeWindow.wmKillFocus(var Msg: TMessage);
  525. begin
  526.   ShowCursor(False);
  527. end;
  528.  
  529. { Use keyboard to simulate mouse events.  Accelerator keys
  530.   are handled as response methods. }
  531. procedure TLifeWindow.wmKeyDown(var Msg: TMessage);
  532. var x, y : Integer;
  533.     pos : TPoint;
  534.     key : word;
  535. begin
  536.   { Determine position of cursor in Window }
  537.   getCursorPos(pos);
  538.   screenToClient(HWindow, pos);
  539.   x:=pos.x;
  540.   y:=pos.y;
  541.   { move the cursor position }
  542.   key := Msg.WParam;
  543.   case key of
  544.     VK_UP    : y := y - gridSize;
  545.     VK_DOWN  : y := y + gridSize;
  546.     VK_RIGHT : x := x + gridSize;
  547.     VK_LEFT  : x := x - gridSize;
  548.     VK_HOME  :
  549.       begin
  550.     x := gridSize div 2;
  551.     y := gridSize div 2;
  552.       end;
  553.     VK_END :
  554.       begin
  555.     x := attr.w - gridSize div 2;
  556.     y := attr.h - gridSize div 2;
  557.       end;
  558.     VK_RETURN,
  559.     VK_SPACE :
  560.       begin
  561.         { Simulate mouse pressing at cursor position }
  562.         Msg.LParam := LongInt(pos);
  563.     wmLButtonDown(Msg);
  564.         wmLButtonUp(Msg);
  565.       end;
  566.     end;
  567.     { Update position of cursor in window with clipping }
  568.     if x < 0 then x := gridSize div 2;
  569.     if y < 0 then y := gridSize div 2;
  570.     if x > cols * gridSize then x:= attr.w - gridSize div 2;
  571.     if y > rows * gridSize then y:= attr.h - gridSize div 2;
  572.     pos.x := x;
  573.     pos.y := y;
  574.     clientToScreen(HWindow, pos);
  575.     setCursorPos(pos.x, pos.y);
  576. end;
  577.  
  578. { Begin capturing mouse movement when the left button is pressed.
  579.   A display context is taken; it is freed in the wmLButtonUp method. }
  580.  
  581. procedure TLifeWindow.wmLButtonDown(var Msg: TMessage);
  582. begin
  583.   if not mouseDown then
  584.   begin
  585.     xDown := -1;     { sentinal values to track movement }
  586.     yDown := -1;
  587.     mouseDown := True;
  588.     mouseMoveDC := GetDC(HWindow);
  589.     selectObject(mouseMoveDC, GetStockObject(White_Pen));
  590.   end;
  591. end;
  592.  
  593. { Update the cells as the mouse is dragged }
  594. procedure TLifeWindow.WMMouseMove(var Msg: TMessage);
  595. var
  596.  xScreen, yScreen, x, y : Integer;
  597.  state : Boolean;
  598. begin
  599.   if mouseDown then
  600.   begin
  601.     { determine where clicked }
  602.     xScreen := Msg.LParamLo;
  603.     yScreen := Msg.LParamHi;
  604.     { translate into cell coordinates }
  605.     x := xScreen div gridSize;
  606.     y := yScreen div gridSize;
  607.     if (x <> xDown) or (y <> yDown) then      { a new position }
  608.     begin
  609.       { Invert the cell's state, then redraw }
  610.       xDown := x;                             { store position }
  611.       yDown := y;
  612.       state := not(cells.aliveCell(x, y));
  613.       cells.setCell(x, y, state);
  614.       cells.drawCell(mouseMoveDC, x, y, state)
  615.     end;
  616.   end;
  617. end;
  618.  
  619. { Stop capturing mouse movement when mouse is released }
  620. procedure TLifeWindow.wmLButtonUp(var Msg: TMessage);
  621. begin
  622.   wmMouseMove(Msg);  { force drawing in same spot }
  623.   if mouseDown then
  624.   begin
  625.     mouseDown := False;
  626.     selectObject(mouseMoveDC, GetStockObject(Black_Pen));
  627.     releaseDC(HWindow, mouseMoveDC);
  628.   end;
  629. end;
  630.  
  631. { Turn off the grid on a double click }
  632. procedure TLifeWindow.wmLButtonDblClk(var Msg: TMessage);
  633. begin
  634.   gridToggle(Msg);
  635. end;
  636.  
  637. { Zoom when right mouse button is pressed }
  638. procedure TLifeWindow.wmRButtonDown(var Msg: TMessage);
  639. begin
  640.   zoom(Msg);
  641. end;
  642.  
  643. { update internal information when resizing then redraw }
  644. procedure TLifeWindow.wmSize(var Msg: TMessage);
  645. begin
  646.   rows := Msg.lParamHi div gridSize;
  647.   cols := Msg.lParamLo div gridSize;
  648.   { update the cells information }
  649.   cells.rows := rows;
  650.   cells.cols := cols;
  651.   attr.h := Msg.lParamHi;
  652.   attr.w := Msg.lParamLo;
  653.   invalidateRect(HWindow, nil, True);
  654. end;
  655.  
  656. type
  657.   { In the wmGetMinMaxInfo message, LParam points to an
  658.     array [0..4] of Points.  The last one can be set to
  659.     the maximum tracking size. }
  660.   PPointArray = ^TPointArray;
  661.   TPointArray = Array[0..4] of TPoint;
  662.  
  663. { Prevent window from becoming larger than maximum array size }
  664. procedure TLifeWindow.wmGetMinMaxInfo(var Msg: TMessage);
  665. var MaxSize : TPoint;
  666. begin
  667.   MaxSize.x := xMax * MinGrid;
  668.   MaxSize.y := yMax * MinGrid;
  669.   PPointArray(Msg.LParam)^[4]:= MaxSize;
  670. end;
  671.  
  672. { When the window is destroyed, stop any timers }
  673. procedure TLifeWindow.wmDestroy(var Msg: TMessage);
  674. begin
  675.   KillTimer(HWindow, 1);
  676.   TWindow.WMDestroy(Msg);
  677. end;
  678.  
  679. {--------------------------------------------------}
  680. { Main program:                                    }
  681. {--------------------------------------------------}
  682.  
  683. var
  684.   Life : TLifeApplication;
  685.  
  686. begin
  687.   Life.Init('PLife');
  688.   Life.Run;
  689.   Life.Done;
  690. end.